home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / textob / textobj.cls < prev    next >
Text File  |  1996-03-06  |  13KB  |  490 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "TextFile"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. '-- Size of buffer when reading file
  11. '   Default = 32K, Max = 64K
  12. Public BlockSize    As Long
  13.  
  14. '-- Error number
  15. Public ErrorNum     As Long
  16.  
  17. '-- Error message
  18. Public ErrorMsg     As String
  19.  
  20.  
  21.  
  22. '-- Contains the file data
  23. Private szData()    As String
  24.  
  25. '-- Number of lines
  26. Private lLines      As Long
  27.  
  28. '-- Holds the current line when searching
  29. Private lCurLine    As Long
  30.  
  31. '-- Holds the current position in the current
  32. '   line when searching
  33. Private lCurPos     As Long
  34.  
  35. '-- String being searched
  36. Private szSearch    As String
  37.  
  38. '-- Case of search term
  39. Private nSearchCase As Integer
  40.  
  41. '-- Bad input file name specified
  42. Private Const ERROR_BAD_FILENAME = 1
  43. '-- No data to save
  44. Private Const ERROR_NO_DATA = 2
  45. '-- No file specified when saving
  46. Private Const ERROR_NO_FILE_SPECIFIED = 3
  47. '-- Could not write to file
  48. Private Const ERROR_FILE_WRITE = 4
  49. '-- Error creating new data
  50. Private Const ERROR_CREATE_NEW = 5
  51.  
  52. Public Sub CreateNew(lLineCount As Long)
  53.  
  54.     Me.ErrorNum = False
  55.     Me.ErrorMsg = ""
  56.     
  57.     On Error Resume Next
  58.     ReDim szData(1 To lLineCount) As String
  59.     If Err Then
  60.         Me.ErrorNum = vbObjectError + ERROR_CREATE_NEW
  61.         Me.ErrorMsg = Error
  62.         Exit Sub
  63.     End If
  64.     
  65.     lLines = lLineCount
  66.     
  67. End Sub
  68.  
  69.  
  70. Public Property Let FoundPos(ByVal nDummy As Integer)
  71.  
  72.     '-- Do not let the user set the search position.
  73.  
  74. End Property
  75.  
  76. Public Property Get FoundPos() As Integer
  77.  
  78.     '-- Return the current position within the current line of
  79.     '   the searched for and found text.
  80.     FoundPos = lCurPos
  81.     
  82. End Property
  83.  
  84. Public Property Get Line(ByVal lIndex As Long) As String
  85. '-- Retreives a line of text from the file.
  86.  
  87.     '-- Trap errors
  88.     On Error Resume Next
  89.     Line = szData(lIndex)
  90.  
  91. End Property
  92.  
  93.  
  94. Public Property Let Line(ByVal lIndex As Long, ByVal szText As String)
  95.  
  96.     '-- Trim Cr and LF chars
  97.     If Right(szText, 1) = vbLf Then
  98.         szText = Left$(szText, Len(szText) - 1)
  99.     End If
  100.     
  101.     If Right(szText, 1) = vbCr Then
  102.         szText = Left$(szText, Len(szText) - 1)
  103.     End If
  104.     
  105.     '-- Return the array element (no CR/LF)
  106.     szData(lIndex) = szText
  107.  
  108. End Property
  109. Public Property Get Lines() As Long
  110.  
  111.     '-- Number of lines
  112.     Lines = lLines
  113.     
  114. End Property
  115.  
  116. Public Property Let Lines(ByVal lDummy As Long)
  117.  
  118.     '-- Do not allow the user to set the number of lines.
  119.  
  120. End Property
  121.  
  122. Public Sub Load(ByVal szFileName As String)
  123. '-- Load the contents of a text file into memory
  124. '   This routine will handle any line that ends with
  125. '   a carriage return, a linefeed, or both.
  126.     
  127.     Dim szBuffer    As String
  128.     Dim lFileNum    As Long
  129.     Dim lFileLen    As Long
  130.     Dim lNumBlocks  As Long
  131.     Dim lRemainder  As Long
  132.     Dim lIndex      As Long
  133.     Dim lPos        As Long
  134.     
  135.     Me.ErrorNum = False
  136.     Me.ErrorMsg = ""
  137.     
  138.     '-- Open the file
  139.     lFileNum = FreeFile
  140.     Open szFileName For Binary As lFileNum
  141.     lFileLen = LOF(lFileNum)
  142.     
  143.     '-- Does the file exist?
  144.     If lFileLen = 0 Then
  145.         Close lFileNum
  146.         Me.ErrorNum = vbObjectError + ERROR_BAD_FILENAME
  147.         Me.ErrorMsg = "File Does Not Exist"
  148.         Exit Sub
  149.     End If
  150.     
  151.     '-- Clear the current array
  152.     Erase szData
  153.     lLines = 0
  154.     
  155.     '-- Get the buffer size
  156.     If BlockSize = 0 Then
  157.         BlockSize = 32768
  158.     ElseIf BlockSize > 65535 Then
  159.         BlockSize = 65535
  160.     End If
  161.     
  162.     '-- Get the number of blocks
  163.     lNumBlocks = lFileLen \ BlockSize
  164.     
  165.     '-- Anything left over?
  166.     lRemainder = lFileLen Mod BlockSize
  167.     
  168.     '-- Read and process each block
  169.     For lIndex = 1 To lNumBlocks
  170.         szBuffer = Space$(BlockSize)
  171.         Get #lFileNum, , szBuffer
  172.         GoSub ProcessData
  173.     Next
  174.     
  175.     '-- Process whatever's left
  176.     If lRemainder Then
  177.         szBuffer = Space$(lRemainder)
  178.         Get #lFileNum, , szBuffer
  179.         GoSub ProcessData
  180.     End If
  181.  
  182.     '-- Close the file and exit
  183.     Close lFileNum
  184.  
  185.     Exit Sub
  186.  
  187. ProcessData:
  188.     
  189.     Do
  190.         '-- Find the next CR
  191.         lPos = InStr(szBuffer, vbCr)
  192.         If lPos Then
  193.             '-- Copy the text up to the CRLF into szData
  194.             lLines = lLines + 1
  195.             ReDim Preserve szData(1 To lLines) As String
  196.             szData(lLines) = Left$(szBuffer, lPos - 1)
  197.             '-- If the next character is a linefeed, skip over it.
  198.             If Asc(Mid$(szBuffer, lPos + 1, 1)) = 10 Then
  199.                 szBuffer = Mid$(szBuffer, lPos + 2)
  200.             Else
  201.                 szBuffer = Mid$(szBuffer, lPos + 1)
  202.             End If
  203.         Else
  204.             '-- Find the next LF
  205.             lPos = InStr(szBuffer, vbLf)
  206.             If lPos Then
  207.                 '-- Copy the text up to the CRLF into szData
  208.                 lLines = lLines + 1
  209.                 ReDim Preserve szData(1 To lLines) As String
  210.                 szData(lLines) = Left$(szBuffer, lPos - 1)
  211.                 szBuffer = Mid$(szBuffer, lPos + 1)
  212.             Else
  213.                 '-- No more CRLFs. More data?
  214.                 If Len(szBuffer) Then
  215.                     '-- Yep. Add it to szData
  216.                     lLines = lLines + 1
  217.                     ReDim Preserve szData(1 To lLines) As String
  218.                     szData(lLines) = szBuffer
  219.                 End If
  220.                 '-- No more data. Exit the loop
  221.                 Exit Do
  222.             End If
  223.         End If
  224.     Loop
  225.     
  226.     Return
  227.  
  228. End Sub
  229. Public Sub LoadListBox(ByVal szFileName As String, List1 As Control)
  230. '-- Loads the contents of a text file into a list box
  231. '   This routine will handle any line that ends with
  232. '   a carriage return, a linefeed, or both.
  233.     
  234.     Dim szBuffer    As String
  235.     Dim lFileNum    As Long
  236.     Dim lFileLen    As Long
  237.     Dim lNumBlocks  As Long
  238.     Dim lRemainder  As Long
  239.     Dim lIndex      As Long
  240.     Dim lPos        As Long
  241.     
  242.     Me.ErrorNum = False
  243.     Me.ErrorMsg = ""
  244.     
  245.     '-- Open the file
  246.     lFileNum = FreeFile
  247.     Open szFileName For Binary As lFileNum
  248.     lFileLen = LOF(lFileNum)
  249.     
  250.     '-- Does the file exist?
  251.     If lFileLen = 0 Then
  252.         Close lFileNum
  253.         Me.ErrorNum = vbObjectError + ERROR_BAD_FILENAME
  254.         Me.ErrorMsg = "File Does Not Exist"
  255.         Exit Sub
  256.     End If
  257.     
  258.     '-- Clear the List Box
  259.     List1.Clear
  260.     
  261.     '-- Get the buffer size
  262.     If BlockSize = 0 Then
  263.         BlockSize = 32768
  264.     ElseIf BlockSize > 65535 Then
  265.         BlockSize = 65535
  266.     End If
  267.     
  268.     '-- Get the number of blocks
  269.     lNumBlocks = lFileLen \ BlockSize
  270.     
  271.     '-- Anything left over?
  272.     lRemainder = lFileLen Mod BlockSize
  273.     
  274.     '-- Read and process each block
  275.     For lIndex = 1 To lNumBlocks
  276.         szBuffer = Space$(BlockSize)
  277.         Get #lFileNum, , szBuffer
  278.         GoSub ProcessData
  279.     Next
  280.     
  281.     '-- Process whatever's left
  282.     If lRemainder Then
  283.         szBuffer = Space$(lRemainder)
  284.         Get #lFileNum, , szBuffer
  285.         GoSub ProcessData
  286.     End If
  287.  
  288.     '-- Close the file and exit
  289.     Close lFileNum
  290.  
  291.     Exit Sub
  292.  
  293. ProcessData:
  294.     
  295.     Do
  296.         '-- Find the next CR
  297.         lPos = InStr(szBuffer, vbCr)
  298.         If lPos Then
  299.             '-- Copy the text up to the CRLF into List1
  300.             List1.AddItem Left$(szBuffer, lPos - 1)
  301.             '-- If the next character is a linefeed, skip over it.
  302.             If Asc(Mid$(szBuffer, lPos + 1, 1)) = 10 Then
  303.                 szBuffer = Mid$(szBuffer, lPos + 2)
  304.             Else
  305.                 szBuffer = Mid$(szBuffer, lPos + 1)
  306.             End If
  307.         Else
  308.             '-- Find the next LF
  309.             lPos = InStr(szBuffer, vbLf)
  310.             If lPos Then
  311.                 '-- Copy the text up to the CRLF into List1
  312.                 List1.AddItem Left$(szBuffer, lPos - 1)
  313.                 szBuffer = Mid$(szBuffer, lPos + 1)
  314.             Else
  315.                 '-- No mo